COMMENT ⊗   VALID 00009 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	entry
C00005 00003	!	compute_func,uncompute_func,error
C00006 00004	!	procedures exp,term,factor,GTOKEN,decode_op
C00014 00005	!	walktree, al version 
C00017 00006	! 	record class declarations: scalar,vector,rot,trans,frame,new_tree
C00020 00007	!	arithcode,makecode 
C00028 00008	!	walktree 
C00035 00009	INTERNAL RPTR(TREE)PROCEDURE GTEXPR
C00037 ENDMK
C⊗;
entry;
BEGIN "GTEXPR"
EXTERNAL STRING TOKEN;

	REQUIRE "[][]" DELIMITERS;
	DEFINE	RPTR	= [RECORD_POINTER],
		RCLASS	= [RECORD_CLASS],
		CRLF	= [('15&'12)],
		$AL$	= [FALSE],
		$POINTY$	= [TRUE],
		SPACE	= [" "],
		NUMERIC_TYPE	= [(2)],
		!	= [COMMENT],
		α	= [BEGIN],
		β	= [END];

!	DEFINE	ID_TYPE	= [(1)];
				define
preload_array(name, defs, type, first, len)=[
	preload_with defs null; type array name[first:first+len] ];

				define

indices(name, postfix)=[
    redefine xxcount=0;
    redefine xx(xxarg)=[
	redefine xxtemp= [ define xxarg]&[postfix=xxcount];
	xxtemp;
	redefine xxcount=xxcount+1;];
    name ];

	define op_list=[
XX(times)
XX(dot)
XX(rel)
XX(backarrow)
XX(divide)
XX(plus)
XX(minus)
XX(WRT)
XX(POS)
XX(UNIT)
XX(AXIS)
XX(ORIENT)
XX(CONSTRUCT)
XX(FRAME)
XX(VECTOR)
XX(TRANS)
XX(MAGNITUDE)
XX(IMPLICIT)
XX(ROT)
];

indices(op_list,_X);


DEFINE #SC=1,#VT=2,#RT=3,#TR=4,#FR=5,#DTYPE=6;

PRELOAD_WITH "NULL","SCALAR","VECTOR","ROT","TRANS","FRAME";
STRING ARRAY $DTYPE[0:5];


DEFINE 		ID_TYPE = 1,
		INT_TYPE = 2,
		REAL_TYPE =  3,
		OPERATOR_TYPE = 4,
		RES_TYPE = 5,
		UNDECLARED_TYPE = 0;
!	compute_func,uncompute_func,error;


EXTERNAL PROCEDURE ERROR(STRING S1,S2(NULL));


INTEGER PROCEDURE COMPUTE_FUNC(INTEGER I1,I2,I3,I4,I5);
	RETURN(((((I1*#DTYPE +I2)*#DTYPE + I3)*#DTYPE) + I4)*#DTYPE +I5);

INTEGER PROCEDURE UNCOMPUTE_FUNC(INTEGER I1,I2);
	α INTEGER I;
		CASE I2 OF
			α	[1]	I←I1 DIV #DTYPE↑4;
				[2]	I←(I1 DIV #DTYPE↑3)MOD #DTYPE;
				[3]	I←(I1 DIV #DTYPE↑2) MOD #DTYPE;
				[4]	I←(I1 DIV #DTYPE) MOD #DTYPE;
				[5]	I←I1 MOD #DTYPE;
				ELSE ERROR("WRONG FIELD IN UNCOMPPUTE_FUNC PARSER ERROR")
			β;
	RETURN(I);
	β;

!	procedures exp,term,factor,GTOKEN,decode_op;

!	E:	{+|-} T {+|- T }

	T:	F {*|/ F}

	F:	( E ), 
		f(  ,  ,  ...)
		<constant>,
		<id>,	;

EXTERNAL PROCEDURE GTOKEN(BOOLEAN AGAIN(TRUE));
EXTERNAL INTEGER #TOKEN;
EXTERNAL BOOLEAN STOKEN;


RCLASS EXP_REC (STRING $OP; RPTR(EXP_REC) SON,YBRO);

FORWARD RECURSIVE RPTR(EXP_REC) PROCEDURE EXP;
FORWARD RECURSIVE RPTR(EXP_REC) PROCEDURE TERM;
FORWARD RECURSIVE RPTR(EXP_REC) PROCEDURE FACTOR;

RPTR(EXP_REC) PROCEDURE NEW_EXP_REC(RPTR(EXP_REC)T1;STRING $OP;RPTR(EXP_REC)T2);
α RPTR(EXP_REC)R1; R1←NEW_RECORD(EXP_REC);
	EXP_REC:$OP[R1]←$OP;
	EXP_REC:SON[R1]←T1;
	EXP_REC:YBRO[R1]←T2;
  RETURN(R1);
β;

RPTR(EXP_REC) PROCEDURE TERM_EXP_REC(STRING $TERM);
α RPTR(EXP_REC)R1; R1←NEW_RECORD(EXP_REC);
	EXP_REC:$OP[R1]←$TERM;
	RETURN(R1);
β;

RECURSIVE RPTR (EXP_REC) PROCEDURE EXP;
α	RPTR (EXP_REC) T1,T2; STRING $OP;
	IF TOKEN="+" OR TOKEN ="-"
	THEN α  $OP←TOKEN; GTOKEN;
		IF (T1←TERM)=NULL_RECORD
		THEN ERROR("Null term after a " &$OP);
		IF $OP="-"
		     THEN T1←NEW_EXP_REC(T1,$OP,NULL_RECORD);
	     β
	ELSE T1←TERM;

	WHILE TOKEN= "+" OR TOKEN = "-" DO 
	    α $OP ← TOKEN; GTOKEN;
		IF (T2←TERM)=NULL_RECORD 
		THEN error("Null term after an "&$OP);
		T1←NEW_EXP_REC(T1, $OP, T2);
	    β;
	RETURN(T1);
β;

RECURSIVE RPTR (EXP_REC) PROCEDURE TERM;
α	RPTR (EXP_REC) T1,T2; STRING $OP;
	T1←FACTOR;
	WHILE TOKEN = "*" OR TOKEN="/" OR TOKEN = "." OR TOKEN="→" OR
		EQU(TOKEN,"WRT") OR EQU(TOKEN,"REL") DO
	    α	$OP←TOKEN;
		IF T1=NULL_RECORD
		THEN ERROR("null factor before a "&$OP);
		GTOKEN;
		IF (T2←FACTOR)=NULL_RECORD
		THEN ERROR("Null factor after a "&$OP);
		IF T1=NULL_RECORD THEN T1←NEW_EXP_REC(T2,$OP,NULL_RECORD)
		ELSE T1←NEW_EXP_REC(T1,$OP,T2);
	    β;
	RETURN(T1);
β;

RECURSIVE RPTR (EXP_REC) PROCEDURE FACTOR;
α	RPTR (EXP_REC) T1,T2,T3; STRING $OP;
IFC $AL$ THENC ! AL PARSER ;
	IF TOKEN = "("
	THEN α GTOKEN;
		IF (T1←EXP)=NULL_RECORD THEN ERROR("null expression found after (");
		IF TOKEN≠")" THEN error("require close paren here")
		ELSE GTOKEN;
	     β
	ELSE ENDC
	IF TOKEN = "|"
	THEN α GTOKEN;
		IF (T1←EXP)=NULL_RECORD THEN ERROR("null expression found after |");
		IF TOKEN≠"|" THEN error("require | paren here")
			ELSE GTOKEN;
		T1←NEW_EXP_REC(T1,"MAGNITUDE",NULL_RECORD);
	     β
	ELSE IF EQU(TOKEN,"POS") OR EQU(TOKEN,"UNIT") OR EQU(TOKEN,"AXIS")
		OR EQU(TOKEN,"ORIENT") OR EQU(TOKEN,"CONSTRUCT") OR 
		EQU(TOKEN,"FRAME") OR EQU(TOKEN,"VECTOR") OR EQU(TOKEN,"TRANS")
		OR EQU(TOKEN,"ROT") IFC $POINTY$ THENC OR EQU(TOKEN,"(") ENDC THEN
	     α
		IFC $POINTY$ THENC
			IF TOKEN="("
			THEN α  $OP←"IMPLICIT"; GTOKEN; β
			ELSE α 	$OP←TOKEN; GTOKEN;
				IF TOKEN≠"(" THEN error("require close paren after "&$OP)
				ELSE GTOKEN; β;
		ELSEC	$OP←TOKEN; GTOKEN;
			IF TOKEN≠"(" THEN error("require close paren after "&$OP)
			ELSE GTOKEN;
		ENDC
		IF (T1←EXP)=NULL_RECORD THEN ERROR("unexpected token after "&$OP&" (");
		T2←new_exp_rec(t1,NULL,null_record);
		T1←NEW_EXP_REC(T2,$OP,NULL_RECORD);
		WHILE TOKEN="," DO
			α GTOKEN;
			IF (T3←EXP)= NULL_RECORD THEN ERROR("unexpected token after ,");
			T3←NEW_EXP_REC(T3,NULL,NULL_RECORD);
			EXP_REC:YBRO[T2]←T3; T2←T3; 
			β;
		IF TOKEN≠")" THEN ERROR("require , or ) here, will insert )")
			ELSE GTOKEN(FALSE);
		IFC $POINTY$ THENC
			IF EQU($OP,"IMPLICIT") AND EXP_REC:YBRO[EXP_REC:SON[T1]] = NULL_RECORD
			THEN T1←EXP_REC:SON[EXP_REC:SON[T1]]; ENDC
	     β
	ELSE CASE #TOKEN OF
		α
		[id_type] α T1←TERM_EXP_REC("$"&TOKEN); GTOKEN(FALSE); β;
		[int_type] α T1←TERM_EXP_REC("#"&TOKEN); GTOKEN(FALSE); β;
		[real_type] α T1←TERM_EXP_REC("%"&TOKEN); GTOKEN(FALSE); β;
		[operator_type]	error("unexpected operator "&token);
		[undeclared_type]	error("undeclared token "&token);
		else error("unexpected token "&token)
		β;

RETURN(t1);
β;

integer procedure decode_op(STRING OP);
α INTEGER Q;
	CASE OP OF
		α	["+"]	Q←PLUS_X;
			["-"]	Q←MINUS_X;
			["*"]	Q←TIMES_X;
			["/"]	Q←DIVIDE_X;
			["→"]	Q←BACKARROW_X;
			["."]	Q←DOT_X;
		
		ELSE IF EQU(OP,"REL") THEN Q←REL_X
		ELSE IF EQU(OP,"WRT") THEN Q←WRT_X
		ELSE IF EQU(OP,"MAGNITUDE") THEN Q←MAGNITUDE_X
		ELSE IF EQU(OP,"POS") THEN Q←POS_X
		ELSE IF EQU(OP,"UNIT") THEN Q←UNIT_X
		ELSE IF EQU(OP,"AXIS") THEN Q←AXIS_X
		ELSE IF EQU(OP,"ORIENT") THEN Q←ORIENT_X
		ELSE IF EQU(OP,"CONSTRUCT") THEN Q←CONSTRUCT_X
		ELSE IF EQU(OP,"FRAME") THEN Q←FRAME_X
		ELSE IF EQU(OP,"VECTOR") THEN Q←VECTOR_X
		ELSE IF EQU(OP,"TRANS") THEN Q←TRANS_X
		ELSE IF EQU(OP,"IMPLICIT") THEN Q←IMPLICIT_X
		ELSE IF EQU(OP,"ROT") THEN Q←ROT_X
		ELSE Q←0

		β;
RETURN(Q);
β;
!	walktree, al version ;

IFC $AL$ THENC
RECURSIVE STRING PROCEDURE WALKTREE(RPTR(EXP_REC)T1);
α STRING S1;
	IF T1=NULL_RECORD
	THEN RETURN(NULL)
	ELSE IF EXP_REC:SON[T1]=NULL_RECORD
	THEN RETURN(EXP_REC:$OP[T1])
	ELSE IF EQU(EXP_REC:$OP[T1],NULL)
	THEN RETURN(NULL)
	ELSE IF EQU(EXP_REC:$OP[T1],"*") OR
		EQU(EXP_REC:$OP[T1],"/") OR
		EQU(EXP_REC:$OP[T1],"+") OR
		EQU(EXP_REC:$OP[T1],"-") OR
		EQU(EXP_REC:$OP[T1],".") OR
		EQU(EXP_REC:$OP[T1],"→") OR
		EQU(EXP_REC:$OP[T1],"WRT") OR
		EQU(EXP_REC:$OP[T1],"MAGNITUDE") OR
		EQU(EXP_REC:$OP[T1],"REL")
	THEN RETURN(CRLF & "( "& EXP_REC:$OP[T1] & CRLF
			& "  " & WALKTREE(EXP_REC:SON[T1]) &
			"  "&(IF EXP_REC:YBRO[T1]≠NULL_RECORD THEN
			CRLF & "  " &WALKTREE(EXP_REC:YBRO[T1]) ELSE NULL) & " )")

	ELSE IF EQU(EXP_REC:$OP[T1],"POS") OR
		EQU(EXP_REC:$OP[T1],"UNIT") OR
		EQU(EXP_REC:$OP[T1],"AXIS") OR
		EQU(EXP_REC:$OP[T1],"ORIENT") OR
		EQU(EXP_REC:$OP[T1],"CONSTRUCT") OR 
		EQU(EXP_REC:$OP[T1],"FRAME") OR
		EQU(EXP_REC:$OP[T1],"VECTOR") OR
		EQU(EXP_REC:$OP[T1],"TRANS") OR
		EQU(EXP_REC:$OP[T1],"IMPLICIT") OR
		EQU(EXP_REC:$OP[T1],"ROT")
	THEN	α RPTR(EXP_REC)T2; S1←WALKTREE(EXP_REC:SON[T2←EXP_REC:SON[T1]]);
		WHILE (T2← EXP_REC:YBRO[T2])≠NULL_RECORD
			DO S1←S1&"  "&WALKTREE(EXP_REC:SON[T2]);
		RETURN(CRLF & "( "&EXP_REC:$OP[T1]&" " &S1&" )");
		β
	ELSE	ERROR("EXPRESSION PARSER ERROR, FOUND "&EXP_REC:$OP[T1]);
β;

ELSEC

! 	record class declarations: scalar,vector,rot,trans,frame,new_tree;
EXTERNAL RCLASS SCALAR (REAL VALUE);
		! value=value of the scalar;

EXTERNAL RCLASS VECTOR (REAL XC,YC,ZC);
		! xc,yc,zc=value of the component of the vector along x,y,z axis;

EXTERNAL RCLASS FRAME (STRING PNAME; RPTR (FRAME) DAD,SON,EBRO,YBRO; INTEGER HOWLINKED;
              REAL ARRAY XF);
		! pname=pname of the frame;
		! dad,son,ebro,ybro=pointers to dad,son,elder and younger brother
		  in frame tree;
		! howlinked=kind of affixment(rigid,nonrigid,independent);
		! xf=array of values
		  xf[1:3,1:3]=rotation matrix,
		  xf[1:3,4]=translation vector,
		  xf[4,1:3]=0,
		  xf[4,4]=1,
		  xf[5,1:3]=rotation angles,
		  xf[5,4]>0 if angles are valid;

EXTERNAL RCLASS ROT (REAL ARRAY XF);
		! xf=array of values (as for frame class);

EXTERNAL RCLASS TRANS(REAL ARRAY XF);
		! xf=array of values (as for frame class);
		! records not entered in $YMTAB, used for computations;
INTERNAL RCLASS TREE(RPTR(SCALAR,VECTOR,TRANS,ROT,FRAME)DATA; INTEGER DTYPE);

INTERNAL RPTR(TREE)PROCEDURE NWTREE(RPTR(SCALAR, VECTOR,ROT,TRANS,FRAME) R; INTEGER T);
	α RPTR(TREE) K; K←NEW_RECORD(TREE);
	TREE:DATA[K]←R; TREE:DTYPE[K]←T; RETURN(K); β;

!	arithcode,makecode ;

REQUIRE "EXPINT.MLG[1,MLG]" SOURCE_FILE;
REQUIRE "⊂⊃⊂⊃" REPLACE_DELIMITERS;

DEFINE OPCODE = ⊂
XX("*",	TIMES_X,	#SC,	#SC,	#SC,	⊂OPSCAL(#1,#2,#3,"*")⊃)
XX("*",	TIMES_X,	#SC,	#VT,	#VT,	⊂OPSCVT(#1,#2,#3,"*")⊃)
XX("*",	TIMES_X,	#VT,	#SC,	#VT,	⊂OPSCVT(#2,#1,#3,"*")⊃)
XX("*",	TIMES_X,	#RT,	#RT,	#RT,	⊂OPRTRT(#1,#2,#3)⊃)
XX("*",	TIMES_X,	#RT,	#VT,	#VT,	⊂OPRTVT(#1,#2,#3)⊃)
XX("*",	TIMES_X,	#TR,	#VT,	#VT,	⊂OPTRVT(#1,#2,#3)⊃)
XX("*",	TIMES_X,	#TR,	#TR,	#TR,	⊂OPTRTR(#1,#2,#3)⊃)
XX("*",	TIMES_X,	#TR,	#FR,	#FR,	⊂OPTRFR(#1,#2,#3)⊃)
XX("*",	TIMES_X,	#FR,	#FR,	#FR,	⊂OPFR(#1,#2,#3)⊃)

XX(".",	DOT_X,		#VT,	#VT,	#SC,	⊂OPDOT(#1,#2,#3)⊃)

XX("REL",	REL_X,	#VT,	#FR,	#VT,	⊂OPVTFR(#2,#1,#3)⊃)

XX("→",	BACKARROW_X,	#FR,	#FR,	#TR,	⊂OPFRFR(#1,#2,#3)⊃)

XX("/",	DIVIDE_X,	#SC,	#SC,	#SC,	⊂OPSCAL(#1,#2,#3,"/")⊃)
XX("/",	DIVIDE_X,	#VT,	#SC,	#VT,	⊂OPSCVT(#2,#1,#3,"/")⊃)

XX("+",	PLUS_X,		#SC,	0,	#SC,	⊂OPSCAL(#1,0,#3,"+")⊃)
XX("+",	PLUS_X,		#VT,	0,	#VT,	⊂OPVET(#1,NEW_RECORD(VECTOR),#3,"+")⊃)
XX("+",	PLUS_X,		#SC,	#SC,	#SC,	⊂OPSCAL(#1,#2,#3,"+")⊃)
XX("+",	PLUS_X,		#VT,	#VT,	#VT,	⊂OPVET(#1,#2,#3,"+")⊃)
XX("+",	PLUS_X,		#FR,	#VT,	#FR,	⊂OPFRVT(#2,#1,#3,"+")⊃)
XX("+",	PLUS_X,		#VT,	#FR,	#FR,	⊂OPFRVT(#1,#2,#3,"+")⊃)

XX("-",	MINUS_X,		#SC,	0,	#SC,	⊂OPSCAL(0,#1,#3,"-")⊃)
XX("-",	MINUS_X,		#VT,	0,	#VT,	⊂OPVET(NEW_RECORD(VECTOR),#1,#3,"-")⊃)
XX("-",	MINUS_X,		#SC,	#SC,	#SC,	⊂OPSCAL(#1,#2,#3,"-")⊃)
XX("-",	MINUS_X,		#VT,	#VT,	#VT,	⊂OPVET(#1,#2,#3,"-")⊃)
XX("-",	MINUS_X,	#FR,	#VT,	#FR,	⊂OPFRVT(#2,#1,#3,"-")⊃)

⊃;

DEFINE MKCODE = ⊂
XX("POS",	POS_X,		FPOS,	#VT,	1,	#FR,	0,	0)
XX("POS",	POS_X,		TPOS,	#VT,	1,	#TR,	0,	0)
XX("UNIT",	UNIT_X,		NORMVT,	#VT,	1,	#VT,	0,	0)
! XX("AXIS",	AXIS_X,		FAXIS,	#VT,	1,	#RT,	0,	0) ;
! XX("ORIENT",	ORIENT_X,	FORIENT,#RT,	1,	#TR,	0,	0) ;
! XX("REL",	REL_X,		RELVT,	#VT,	2,	#VT,	#FR,	0) ;
! XX("REL",	REL_X,		RELFR,	#FR,	2,	#FR,	#TR,	0) ;
! XX("WRT",	WRT_X,		WRTVT,	#VT,	2,	#VT,	#FR,	0) ;
XX("ORIENT",	ORIENT_X,	FORIEN,	#RT,	1,	#FR,	0,	0)
XX("TRANS",	TRANS_X,	TMAKE,	#TR,	2,	#RT,	#VT,	0)
XX("ROT",	ROT_X,		RMAKE,	#RT,	2,	#VT,	#SC,	0)
XX("FRAME",	FRAME_X,	FMAKE,	#FR,	2,	#RT,	#VT,	0) 
XX("VECTOR",	VECTOR_X,	VMAKE,	#VT,	3,	#SC,	#SC,	#SC)
XX("CONSTRUCT",	CONSTRUCT_X,	CONSV,	#FR,	3,	#VT,	#VT,	#VT)
XX("CONSTRUCT",	CONSTRUCT_X,	CONSF,	#FR,	3,	#FR,	#FR,	#FR)
XX("MAGNITUDE",	MAGNITUDE_X,	SMOD,	#SC,	1,	#SC,	0,	0)
XX("MAGNITUDE",	MAGNITUDE_X,	VMOD,	#SC,	1,	#VT,	0,	0)
! XX("MAGNITUDE",	MAGNITUDE_X,	RMOD,	#SC,	1,	#RT,	0,	0) ;
XX("IMPLICIT",	IMPLICIT_X,		VMAKE,	#VT,	3,	#SC,	#SC,	#SC)
XX("IMPLICIT",	IMPLICIT_X,	RMAKE,	#RT,	2,	#VT,	#SC,	0)
XX("IMPLICIT",	IMPLICIT_X,	TMAKE,	#TR,	2,	#RT,	#VT,	0)
⊃;
RECURSIVE RPTR(TREE) PROCEDURE MAKE_CODE(STRING $OP;RPTR(TREE)R1,R2,R3,R4);
α	RPTR(TREE)X1; INTEGER PP;
REDEFINE XX(OP,OP_TYPE,OP_FUNC,OP_DTYPE,#n,#1,#2,#3) = ⊂
	redefine xx_val = (((op_type*#dtype + #1)* #dtype + #2)*#dtype + #3)*#DTYPE ;
	redefine xx_temp = ⊂ IF PP=xx_val THEN
			   CASEC #n OFC
				⊂X1←NWTREE(OP_FUNC,OP_DTYPE)⊃,
				⊂X1←NWTREE(OP_FUNC(TREE:DATA[R1]),OP_DTYPE)⊃,
				⊂X1←NWTREE(OP_FUNC(TREE:DATA[R1],TREE:DATA[R2]),OP_DTYPE)⊃,
				⊂X1←NWTREE(OP_FUNC(TREE:DATA[R1],TREE:DATA[R2],TREE:DATA[R3]),OP_DTYPE)⊃,
			   ⊂REQUIRE " HAH" MESSAGE;⊃ ENDC
			   ELSE ⊃;
	xx_temp ⊃;

	PP←COMPUTE_FUNC(DECODE_OP($OP),
		(IF R1≠NULL_RECORD THEN TREE:DTYPE[R1] ELSE 0),
		(IF R2≠NULL_RECORD THEN TREE:DTYPE[R2] ELSE 0),
		(IF R3≠NULL_RECORD THEN TREE:DTYPE[R3] ELSE 0),
		(IF R4≠NULL_RECORD THEN TREE:DTYPE[R4] ELSE 0));
	MKCODE
	ERROR($OP&" cannot take argument(s) type(s) "&
		(IF R1≠NULL_RECORD THEN $DTYPE[TREE:DTYPE[R1]]&", " ELSE NULL)&
		(IF R2≠NULL_RECORD THEN $DTYPE[TREE:DTYPE[R2]]&", " ELSE NULL)&
		(IF R3≠NULL_RECORD THEN $DTYPE[TREE:DTYPE[R3]]&", " ELSE NULL)&
		(IF R4≠NULL_RECORD THEN $DTYPE[TREE:DTYPE[R4]]&", " ELSE NULL));

	return(X1);

β;

RECURSIVE RPTR(TREE)PROCEDURE ARITH_CODE(RPTR(TREE)R1,R2; STRING $OP);
α	INTEGER SUB_TYPE; RPTR(TREE) R3; INTEGER PP;
		SUB_TYPE←0; R3←NEW_RECORD(TREE);

REDEFINE XX(OP,OP_TYPE,TYPE1,TYPE2,TYPE3,FUNC) =
	⊂ redefine xx_val =  (op_type* #dtype + type1)* #dtype +type2 ;
		redefine #1 = ⊂
			redefine xx_1 =  IFC TYPE1= #SC THENC ⊂SCALAR:VALUE[TREE:DATA[R1]]⊃
				ELSEC ⊂TREE:DATA[R1]⊃ ENDC; 
			xx_1⊃;
		redefine #2 = ⊂
			redefine xx_2 = IFC TYPE2= #SC THENC ⊂SCALAR:VALUE[TREE:DATA[R2]]⊃
				ELSEC ⊂TREE:DATA[R2]⊃ ENDC;
			xx_2⊃;
		redefine #3 = ⊂TREE:DATA[R3]⊃;
	  redefine xx_temp = ⊂
		[ xx_val ] BEGIN 
		IFC (#SC≤TYPE3≤#FR) THENC
			TREE:DATA[R3]←MK_REC(TYPE3);
		ELSEC	REQUIRE " HAH " MESSAGE; ENDC
			   func ; TREE:DTYPE[R3]←TYPE3; END; ⊃ ;
	  xx_temp ⊃;

	CASE (PP←COMPUTE_FUNC(0,0,DECODE_OP($OP),TREE:DTYPE[R1],
		(IF R2=NULL_RECORD THEN 0 ELSE TREE:DTYPE[R2]))) OF
	α
	OPCODE
	ELSE  ERROR($OP&" cannot take argument(s) type(s) "&
		(IF R1≠NULL_RECORD THEN $DTYPE[TREE:DTYPE[R1]] ELSE "***")&
		(IF R2≠NULL_RECORD THEN ", "&$DTYPE[TREE:DTYPE[R2]] ELSE NULL))
	β;

	return(R3);
β;

!	walktree ;
RECURSIVE RPTR(TREE) PROCEDURE WALKTREE(RPTR(EXP_REC)T1);
α RPTR(TREE)R1,R2,R3;
	IF T1=NULL_RECORD
	THEN RETURN(NULL_RECORD)
	ELSE IF EXP_REC:SON[T1]=NULL_RECORD
	THEN α	STRING S; S←EXP_REC:$OP[T1];
		CASE LOP(S) OF 
		α
		["$"]	RETURN(DCDSYM(S));
		["#"]
		["%"]	α RPTR(SCALAR)Q1; INTEGER I;
			Q1←NEW_RECORD(SCALAR);
			SCALAR:VALUE[Q1]←REALSCAN(S,I);
			RETURN(NWTREE(Q1,#SC));β;

		ELSE	ERROR("PARSER ERROR, TELL SOMEBODY")
	     β  β
	ELSE IF EQU(EXP_REC:$OP[T1],NULL)
	THEN RETURN(NULL_RECORD)
	ELSE IF EQU(EXP_REC:$OP[T1],"*") OR
		EQU(EXP_REC:$OP[T1],"/") OR
		EQU(EXP_REC:$OP[T1],"+") OR
		EQU(EXP_REC:$OP[T1],"-") OR
		EQU(EXP_REC:$OP[T1],".") OR
		EQU(EXP_REC:$OP[T1],"→") OR
		EQU(EXP_REC:$OP[T1],"WRT") OR
		EQU(EXP_REC:$OP[T1],"REL")
	THEN 	α R1←WALKTREE(EXP_REC:SON[T1]);
		R2←WALKTREE(EXP_REC:YBRO[T1]);
		RETURN(ARITH_CODE(R1,R2,EXP_REC:$OP[T1])); β
	ELSE IF EQU(EXP_REC:$OP[T1],"POS") OR
		EQU(EXP_REC:$OP[T1],"UNIT") OR
		EQU(EXP_REC:$OP[T1],"AXIS") OR
		EQU(EXP_REC:$OP[T1],"ORIENT") OR
		EQU(EXP_REC:$OP[T1],"TRANS") OR
		EQU(EXP_REC:$OP[T1],"ROT") OR
		EQU(EXP_REC:$OP[T1],"FRAME") OR
		EQU(EXP_REC:$OP[T1],"VECTOR") OR
		EQU(EXP_REC:$OP[T1],"MAGNITUDE") OR
		EQU(EXP_REC:$OP[T1],"CONSTRUCT") OR 
		EQU(EXP_REC:$OP[T1],"IMPLICIT")
	THEN	α RPTR(EXP_REC)T2;RPTR(TREE)R1,R2,R3,R4;
		R1←WALKTREE(EXP_REC:SON[T2←EXP_REC:SON[T1]]);
		IF (T2← EXP_REC:YBRO[T2])≠NULL_RECORD THEN
			α  R2←WALKTREE(EXP_REC:SON[T2]);
			   IF (T2←EXP_REC:YBRO[T2])≠NULL_RECORD THEN
				α R3←WALKTREE(EXP_REC:SON[T2]);
				IF (T2←EXP_REC:YBRO[T2])≠NULL_RECORD THEN
					R4←WALKTREE(EXP_REC:SON[T2]);
				β;
			β;
		RETURN(MAKE_CODE(EXP_REC:$OP[T1],R1,R2,R3,R4));
		β

	ELSE	ERROR("EXPRESSION PARSER ERROR, FOUND "&EXP_REC:$OP[T1]);
β;

ENDC
INTERNAL RPTR(TREE)PROCEDURE GTEXPR;
α RPTR(EXP_REC) T1;RPTR(TREE)T2;
	GTOKEN;
	T1←EXP;
	T2←WALKTREE(T1);
	STOKEN←TRUE;
	RETURN(T2);
β;

END;